home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Disc to the Future 2
/
Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin
/
MAC
/
THINKC
/
5
/
READER_1
/
FDS__1_0
/
SOUNDEDI
/
SOUNDEDI.P
< prev
Wrap
Text File
|
1992-07-19
|
7KB
|
323 lines
unit SoundEditFD;
interface
uses
FormatDriver, Sound;
function Main (message: Integer; window: WindowPtr; param1, param2: LongInt): LongInt;
implementation
function DoInit (system: SysEnvPtr): LongInt;
FORWARD;
function DoOpen (window: WindowPtr; fileName: StringPtr; vRefNum: Integer): OSErr;
FORWARD;
procedure DoClose (window: WindowPtr);
FORWARD;
procedure DoMenuSelect (window: WindowPtr; menuID, menuItem: Integer);
FORWARD;
procedure DoMenuUpdate (window: WindowPtr);
FORWARD;
procedure DoInControl (window: WindowPtr; mouseLoc: Point; control: ControlHandle);
FORWARD;
function Main (message: Integer; window: WindowPtr; param1, param2: LongInt): LongInt;
begin
Main := noErr;
case message of
rmInit:
Main := DoInit(SysEnvPtr(param1));
rmOpen:
Main := DoOpen(window, StringPtr(param1), LoWord(param2));
rmClose:
DoClose(window);
rmMenuSelect:
DoMenuSelect(window, param1, param2);
rmMenuUpdate:
DoMenuUpdate(window);
rmInControl:
DoInControl(window, Point(param1), ControlHandle(param2));
end;
end;
const
errOldSystem = 1000;
errCantPlayIt = 1001;
errCompressed = 1002;
type
INFOrecord = record
reserved0: LongInt;
reserved1: LongInt;
recordFreq: Fixed;
playbackFreq: Fixed;
compressionMode: LongInt; { 0 = none, 1 = 8:1, 2 = 4:1, 3 = 3:1, 4 = 6:1 }
mode: LongInt; { 0 = mono, 1 = stereo }
windowPosition: LongInt;
sampleRate: LongInt; { 1 = 22KHz, 2 = 11KHz, 3 = 7KHz, 4 = 5KHz }
sampleLength: LongInt;
rightSampleLen: LongInt;
reserved10: LongInt;
reserved11: LongInt;
reserved12: LongInt;
reserved13: LongInt;
reserved14: LongInt;
reserved15: LongInt;
end;
INFOptr = ^INFOrecord;
INFOhdl = ^INFOptr;
DocumentRecord = record
theData: Handle;
theButton: ControlHandle;
theItem: Integer;
theINFO: INFOhdl;
end;
DocumentPtr = ^DocumentRecord;
DocumentHdl = ^DocumentPtr;
{ ========== support routines ========== }
procedure BeginFDriver (window: WindowPtr; var document: DocumentHdl);
begin
document := DocumentHdl(GetWRefCon(window));
HLock(Handle(document));
end;
procedure EndFDriver (document: DocumentHdl);
begin
HUnlock(Handle(document));
end;
{ ========== message handlers ========== }
function DoInit (system: SysEnvPtr): LongInt;
const
goodSystem = $0602;
begin
DoInit := 0;
if system^.systemVersion < goodSystem then
begin
InfoAlert(errOldSystem);
DoInit := rmError;
end;
end;
function DoOpen (window: WindowPtr; fileName: StringPtr; vRefNum: Integer): OSErr;
var
document: DocumentHdl;
refNum: Integer;
logEOF: LongInt;
theHdl: Handle;
theControl: ControlHandle;
error: OSErr;
begin
error := FSOpen(fileName^, vRefNum, refNum);
if error <> noErr then
begin
DoOpen := error;
Exit(DoOpen);
end;
error := GetEOF(refNum, logEOF);
if error <> noErr then
begin
DoOpen := error;
error := FSClose(refNum);
Exit(DoOpen);
end;
theHdl := NewHandle(logEOF);
if (theHdl = nil) then
begin
DoOpen := memFullErr;
error := FSClose(refNum);
Exit(DoOpen);
end;
HLock(theHdl);
error := FSRead(refNum, logEOF, theHdl^);
HUnlock(theHdl);
if error <> noErr then
begin
DoOpen := error;
DisposHandle(theHdl);
error := FSClose(refNum);
Exit(DoOpen);
end;
error := FSClose(refNum);
theControl := GetNewControl(1000, window);
if ResError <> noErr then
begin
DoOpen := ResError;
DisposHandle(theHdl);
Exit(DoOpen);
end;
document := DocumentHdl(NewHandle(sizeof(DocumentRecord)));
if (document = nil) then
begin
DoOpen := memFullErr;
DisposeControl(theControl);
DisposHandle(theHdl);
Exit(DoOpen);
end;
HLock(Handle(document));
with document^^ do
begin
theData := theHdl;
theButton := theControl;
theItem := 2;
theINFO := nil;
refNum := OpenRFPerm(fileName^, vRefNum, fsRdPerm);
if refNum <> -1 then
begin
theINFO := INFOhdl(Get1Resource('INFO', 1000));
if (theINFO <> nil) then
begin
theItem := theINFO^^.sampleRate + 1;
DetachResource(Handle(theINFO));
end;
CloseResFile(refNum);
end;
end;
HUnlock(Handle(document));
SetWRefCon(window, LongInt(document));
with document^^ do
if theINFO <> nil then
if theINFO^^.compressionMode > 0 then
begin
DoClose(window);
InfoAlert(errCompressed);
DoOpen := rmError;
Exit(DoOpen);
end;
SizeWindow(window, 300, 100, true);
MoveWindow(window, 80, 80, false);
DoOpen := noErr;
end;
procedure DoClose (window: WindowPtr);
var
document: DocumentHdl;
begin
BeginFDriver(window, document);
with document^^ do
begin
if theINFO <> nil then
DisposHandle(Handle(theINFO));
DisposHandle(theData);
end;
EndFDriver(document);
DisposHandle(Handle(document));
end;
procedure DoMenuSelect (window: WindowPtr; menuID, menuItem: Integer);
var
document: DocumentHdl;
begin
BeginFDriver(window, document);
if menuID = 1000 then
document^^.theItem := menuItem;
EndFDriver(document);
end;
procedure DoMenuUpdate (window: WindowPtr);
var
document: DocumentHdl;
menu: MenuHandle;
index: Integer;
disable: Boolean;
begin
menu := GetMHandle(1000);
if menu = nil then
Exit(DoMenuUpdate);
BeginFDriver(window, document);
disable := (document^^.theINFO <> nil);
for index := 1 to CountMItems(menu) do
begin
CheckItem(menu, index, false);
if disable then
DisableItem(menu, index)
else
EnableItem(menu, index);
end;
CheckItem(menu, document^^.theItem, true);
EndFDriver(document);
end;
procedure DoInControl (window: WindowPtr; mouseLoc: Point; control: ControlHandle);
var
document: DocumentHdl;
error: OSErr;
chan: SndChannelPtr;
cmd: SndCommand;
sample: SoundHeader;
begin
BeginFDriver(window, document);
with document^^ do
begin
if TrackControl(control, mouseLoc, nil) <> 0 then
if control = theButton then
begin
chan := nil;
error := SndNewChannel(chan, sampledSynth, initMono, nil);
if error <> noErr then
begin
InfoAlert(errCantPlayIt);
EndFDriver(document);
Exit(DoInControl);
end;
SetCursor(GetCursor(watchCursor)^^);
HLock(theData);
with sample do
begin
samplePtr := theData^;
length := GetHandleSize(theData);
case theItem of
1:
sampleRate := $AC440000;
2:
sampleRate := $56EE8BA3;
3:
sampleRate := $2B7745D1;
4:
sampleRate := $1CFA2E8B;
5:
sampleRate := $15BBA2E8;
end;
loopStart := 1;
loopEnd := length;
baseFrequency := 60;
end;
cmd.cmd := bufferCmd;
cmd.param1 := 0;
cmd.param2 := LongInt(@sample);
error := SndDoImmediate(chan, cmd);
if error <> noErr then
InfoAlert(errCantPlayIt);
error := SndDisposeChannel(chan, false);
HUnlock(theData);
InitCursor;
end;
end;
EndFDriver(document);
end;
end.